home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MOS / GEMDOSIO.I < prev    next >
Encoding:
Modula Implementation  |  1990-11-10  |  3.6 KB  |  140 lines
  1. IMPLEMENTATION MODULE GEMDOSIO;
  2. (*$B+,Y+,S-,M-,R-*)
  3.  
  4. (*
  5.  * Treibermodul.
  6.  *
  7.  * Leitet alle Ein- und Ausgaben von 'InOut' auf 'Console'.
  8.  *
  9.  * Näheres siehe Definitions-Text
  10.  *)
  11.  
  12. FROM SYSTEM IMPORT WORD, LONGWORD, ADR, BYTE, ADDRESS;
  13. IMPORT Console, InOutBase;
  14. FROM Strings IMPORT Delete;
  15. FROM MOSGlobals IMPORT MemArea;
  16. FROM ResCtrl IMPORT RemovalCarrier, CatchRemoval;
  17.  
  18. VAR ok: BOOLEAN;
  19.  
  20. PROCEDURE myReadLine (VAR s: ARRAY OF CHAR);
  21.   BEGIN
  22.     Console.ReadLine (s);
  23.     Console.WriteLn
  24.   END myReadLine;
  25.  
  26. PROCEDURE CondRead (VAR c: CHAR; VAR ok: BOOLEAN);
  27.   BEGIN
  28.     Console.BusyRead (c);
  29.     ok:= c # 0C
  30.   END CondRead;
  31.  
  32. PROCEDURE WritePg;
  33.   BEGIN
  34.     Console.Write (33C);
  35.     Console.Write ('E')
  36.   END WritePg;
  37.  
  38. PROCEDURE GotoXY (x,y: CARDINAL);
  39.   BEGIN
  40.     Console.Write (33C);
  41.     Console.Write ('Y');
  42.     Console.Write (CHR(y+32));
  43.     Console.Write (CHR(x+32));
  44.   END GotoXY;
  45.  
  46. PROCEDURE Open (x,y: CARDINAL);
  47.   END Open;
  48.  
  49. PROCEDURE Close;
  50.   END Close;
  51.  
  52. PROCEDURE GetInput ( VAR name: ARRAY OF CHAR );
  53.   BEGIN
  54.     myReadLine (name);
  55.   END GetInput;
  56.  
  57. PROCEDURE GetOutput ( VAR name: ARRAY OF CHAR; VAR append: BOOLEAN );
  58.   BEGIN
  59.     myReadLine (name);
  60.     append:= name[0] = '>';
  61.     IF append THEN
  62.       Delete (name,0,1,ok)
  63.     END;
  64.   END GetOutput;
  65.  
  66. PROCEDURE OpenError ( VAR msg: ARRAY OF CHAR; VAR retry: BOOLEAN );
  67.   VAR c: CHAR;
  68.   BEGIN
  69.     Console.WriteLn;
  70.     Console.WriteString ('Fehler beim Öffnen: ');
  71.     Console.WriteString (msg);
  72.     Console.WriteLn;
  73.     Console.WriteString ('Nochmalige Eingabe ? (J/N) ');
  74.     REPEAT
  75.       Console.Read (c);
  76.       c:= CAP (c)
  77.     UNTIL (c='J') OR (c='N');
  78.     retry:= c='J';
  79.     Console.WriteLn;
  80.   END OpenError;
  81.  
  82. PROCEDURE IOError ( VAR msg: ARRAY OF CHAR; input: BOOLEAN );
  83.   VAR c: CHAR;
  84.   BEGIN
  85.     Console.WriteLn;
  86.     Console.WriteString ('Fehler bei Datei');
  87.     IF input THEN
  88.       Console.WriteString ('eingabe: ')
  89.     ELSE
  90.       Console.WriteString ('ausgabe: ')
  91.     END;
  92.     Console.WriteString (msg);
  93.     Console.WriteLn;
  94.     Console.WriteString ('Datei wird geschlossen. Bitte Taste drücken. ');
  95.     Console.FlushKbd;
  96.     Console.Read (c);
  97.     Console.WriteLn;
  98.   END IOError;
  99.  
  100. VAR pbuf: ARRAY [0..14] OF LONGWORD; pidx: CARDINAL;
  101.  
  102. PROCEDURE pset (f:BOOLEAN);
  103.   PROCEDURE pswap (VAR l:LONGWORD; v:LONGWORD);
  104.     (*$R+*)
  105.     BEGIN
  106.       IF f THEN pbuf [pidx]:= l; l:= v ELSE l:= pbuf [pidx] END;
  107.       INC (pidx)
  108.     END pswap;
  109.     (*$R=*)
  110.   BEGIN
  111.     pidx:= 0;
  112.     pswap (InOutBase.Read, ADDRESS (Console.Read));
  113.     pswap (InOutBase.Write, ADDRESS (Console.Write));
  114.     pswap (InOutBase.OpenWdw, ADDRESS (Open));
  115.     pswap (InOutBase.CloseWdw, ADDRESS (Close));
  116.     pswap (InOutBase.KeyPressed, ADDRESS (Console.KeyPressed));
  117.     pswap (InOutBase.CondRead, ADDRESS (CondRead));
  118.     pswap (InOutBase.WriteLn, ADDRESS (Console.WriteLn));
  119.     pswap (InOutBase.WritePg, ADDRESS (WritePg));
  120.     pswap (InOutBase.WriteString, ADDRESS (Console.WriteString));
  121.     pswap (InOutBase.ReadString, ADDRESS (myReadLine));
  122.     pswap (InOutBase.GotoXY, ADDRESS (GotoXY));
  123.     pswap (InOutBase.GetInput, ADDRESS (GetInput));
  124.     pswap (InOutBase.GetOutput, ADDRESS (GetOutput));
  125.     pswap (InOutBase.OpenError, ADDRESS (OpenError));
  126.     pswap (InOutBase.IOError, ADDRESS (IOError));
  127.   END pset;
  128.  
  129. PROCEDURE restore;
  130.   BEGIN
  131.     pset (FALSE) (* Wiederherstellen der alten PROC-Werte *)
  132.   END restore;
  133.  
  134. VAR tc: RemovalCarrier; st: MemArea;
  135.  
  136. BEGIN
  137.   CatchRemoval (tc, restore, st);
  138.   pset (TRUE)   (* Retten der alten PROC-Werte und Setzen der Neuen *)
  139. END GEMDOSIO.
  140.